home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / tests / sample_rexx_host.f < prev    next >
Encoding:
FORTH Source  |  1992-04-23  |  2.7 KB  |  129 lines
  1. 0 .IF
  2. Example REXX Host that responds to several ARexx Commands
  3. The command set for this host was chosen to demonstrate a
  4. variety of formats, not for their usefulness.
  5.  
  6. Command Set:
  7.  
  8.     CALCSUM  a b                - returns A+B
  9.     TYPETEXT "a string" ntimes  - types text N times
  10.     TYPEREM "a string"          - types remainder of line
  11.     INCTEXT "a string" inc      - add to chars in string
  12.     GOAWAY                      - quit
  13.     
  14. .THEN
  15.  
  16. \ Author: Phil Burk
  17. \ Copyright 1991 Phil Burk
  18.  
  19. \ 00001 PLB 4/23/92 Add TYPEREM to test "R" format.
  20.  
  21. getmodule includes
  22. getmodule arexxmod
  23.  
  24. include? CreatePort() ju:exec_support
  25. include? tolower ju:char-macros
  26. include? task-arexxTools.f jrx:ARexxTools.f
  27. include? { ju:locals
  28.  
  29. ANEW TASK-SAMPLE_REXX_HOST.F
  30.  
  31. \ These are the words that implement the command set --------
  32. : SRH.CALCSUM ( A B -- , add two numbers and print )
  33.     +  \ calculate sum
  34.     ." Sum = " dup . cr  \ print it just for fun
  35. \
  36. \ now pass it back to caller via argstring result2
  37.     n>text CreateARgString() rx-result2 !
  38. ;
  39.  
  40. : SRH.TYPETEXT ( addr count num -- , type string N times )
  41.     >newline
  42.     0
  43.     DO
  44.         2dup type cr
  45.     LOOP
  46.     2drop
  47. ;
  48.  
  49. : SRH.TYPEREM ( addr count -- )
  50.     type cr
  51. ;
  52.  
  53. : SRH.INCTEXT { addr cnt inc -- , add INC to each char of string }
  54.     cnt 0
  55.     DO
  56.         addr i + c@ inc +
  57.         addr i + c!
  58.     LOOP
  59. \
  60. \ now pass it back to caller via argstring result2
  61.     addr cnt CreateARgString() rx-result2 !
  62. ;
  63.  
  64. : SRH.GOAWAY ( --  , quit )
  65.     rx-quit on
  66. ;
  67.  
  68. \ These words setup the ARexx interface and run it. ----------
  69. : SRH.INIT ( -- error? )
  70.     0" SAMPLEREXXHOST" rx.init 0=
  71.     IF
  72. \
  73. \ set optional filename extension, eg. macro1.SRH
  74.         0" srh" rx-message-ptr @ s! rm_FileExt
  75. \
  76. \ Allocate space for some commands
  77.         5 rx.alloc.ctable
  78.         IF
  79. \ Define command set
  80.             " CALCSUM"  " NN" 'c srh.calcsum  rx.add.command
  81.             " TYPETEXT" " SN" 'c srh.typetext rx.add.command
  82.             " TYPEREM"  " R"  'c srh.typerem rx.add.command
  83.             " INCTEXT"  " SN" 'c srh.inctext rx.add.command
  84. \ For no parameters, use "" which is one Forth word with 2 doublequotes!
  85.             " GOAWAY"   "" 'c srh.goaway   rx.add.command
  86.             false
  87.         ELSE
  88.             ." SRH.INIT - Could not allocate CTABLE!" cr
  89.             true
  90.         THEN
  91.     ELSE
  92.         ." SRH.INIT - Could not initialize port!" cr
  93.         true
  94.     THEN
  95. ;
  96.  
  97. : SRH.TERM ( -- , cleanup )
  98.     rx.free.ctable
  99.     rx.term
  100. ;
  101.  
  102. if.forgotten srh.term
  103.  
  104. \ Here are two possible ways of running this program.
  105. : SRH.SLAVE  ( -- , accept ARexx commands until RX-QUIT )
  106.     srh.init 0=
  107.     IF
  108.         rx.slave.safe
  109.         srh.term
  110.     THEN
  111. ;
  112.  
  113. : SRH.MACRO  ( -- , fire off an ARexx macro that talks back to us )
  114.     srh.init 0=
  115.     IF
  116.         0" jrx:tests/macro1" rx.put.rexx
  117.         IF
  118.             ." SRH.MACRO error reported!" cr
  119.         THEN
  120.         srh.term
  121.     THEN
  122. ;
  123.  
  124. cr
  125. ." Enter in JForth:   SRH.MACRO" cr cr
  126. ." OR enter in JForth:   SRH.SLAVE" cr
  127. ."    then enter in the CLI:   RX  JRX:TESTS/DRIVE.SRH" cr
  128.  
  129.